      SUBROUTINE INITBIN3  
C  
C M.R. MORTON    29 APR 1999  
C CHANGE RECORD  
C INITIALIZES BINARY FILE FOR EFDC OUTPUT.  PLACES CONTROL  
C PARAMETERS FOR POST-PROCESSOR IN HEADER SECTION OF BINARY  
C FILE WQDOCOMP.BIN FOR D.O. COMPONENT ANALYSIS.  
C  
      USE GLOBAL  
      REAL,SAVE,ALLOCATABLE,DIMENSION(:)::XLON  
      REAL,SAVE,ALLOCATABLE,DIMENSION(:)::YLAT  
      LOGICAL FEXIST,IS1OPEN,IS2OPEN  
      CHARACTER*20 WQNAME(33)  
      CHARACTER*10 WQUNITS(33)  
      CHARACTER*3  WQCODE(33)  

      IF(.NOT.ALLOCATED(XLON))THEN
		ALLOCATE(XLON(LCM))
		ALLOCATE(YLAT(LCM))
	    XLON=0.0 
	    YLAT=0.0 
	ENDIF
C  
C THE FOLLOWING PARAMETERS ARE SPECIFIED IN EFDC.INP AND WQ3DWC.INP:  
C KC       = NUMBER OF VERTICAL LAYERS  
C IWQTSDT  = NUMBER OF TIME STEPS PER DATA DUMP  
C DT       = TIME STEP OF EFDC MODEL IN SECONDS  
C LA       = NUMBER OF ACTIVE CELLS + 1 IN MODEL  
C TBEGAN   = BEGINNING TIME OF RUN IN DAYS  
C THE PARAMETER NPARM MUST BE CHANGED IF THE OUTPUT DATA  
C IS CHANGED IN SUBROUTINE WWQTSBIN:  
C NPARM   = NUMBER OF PARAMETERS WRITTEN TO BINARY FILE  
C NREC3   = NUMBER OF RECORDS WRITTEN TO BINARY FILE (ONE RECORD  
C           IS A COMPLETE DATA DUMP FOR TIME INTERVAL IWQDIUDT)  
C  
      NPARM = 33  
      NCELLS = LA-1  
      NREC3 = 0  
      TEND = TBEGIN  
      MAXRECL3 = 32  
      IF(NPARM .GE. 8)THEN  
        MAXRECL3 = NPARM*4  
      ENDIF  
C  
C THE FOLLOWING WATER QUALITY NAMES, UNITS, AND 3-CHARACTER CODES  
C SHOULD BE MODIFIED TO MATCH THE PARAMETERS WRITTEN TO THE BINARY  
C FILE IN SUBROUTINE WWQTSBIN.  THE CHARACTER STRINGS MUST BE  
C EXACTLY THE LENGTH SPECIFIED BELOW IN ORDER FOR THE POST-PROCESSOR  
C TO WORK CORRECTLY.  
C BE SURE WQNAME STRINGS ARE EXACTLY 20-CHARACTERS LONG:  
C------------------'         1         2'  
C------------------'12345678901234567890'  
C  
      WQNAME( 1) = 'NITROGEN_LIMIT_CYA  '  
      WQNAME( 2) = 'NITROGEN_LIMIT_DIA  '  
      WQNAME( 3) = 'NITROGEN_LIMIT_GRN  '  
      WQNAME( 4) = 'NITROGEN_LIMIT_MAC  '  
      WQNAME( 5) = 'PHOSPHORUS_LIMIT_CYA'  
      WQNAME( 6) = 'PHOSPHORUS_LIMIT_DIA'  
      WQNAME( 7) = 'PHOSPHORUS_LIMIT_GRN'  
      WQNAME( 8) = 'PHOSPHORUS_LIMIT_MAC'  
      WQNAME( 9) = 'LIGHT_LIMIT_CYA     '  
      WQNAME(10) = 'LIGHT_LIMIT_DIA     '  
      WQNAME(11) = 'LIGHT_LIMIT_GRN     '  
      WQNAME(12) = 'LIGHT_LIMIT_MAC     '  
      WQNAME(13) = 'TEMP_LIMIT_CYA      '  
      WQNAME(14) = 'TEMP_LIMIT_DIA      '  
      WQNAME(15) = 'TEMP_LIMIT_GRN      '  
      WQNAME(16) = 'TEMP_LIMIT_MAC      '  
      WQNAME(17) = 'VELOCITY_LIMIT_MAC  '  
      WQNAME(18) = 'DENSITY_LIMIT_MAC   '  
      WQNAME(19) = 'DO_SATURATION       '  
      WQNAME(20) = 'DO_POINT_SOURCES    '  
      WQNAME(21) = 'DO_SED_OXYGEN_DEMAND'  
      WQNAME(22) = 'DO_REAERATION       '  
      WQNAME(23) = 'DO_DOC_DECAY        '  
      WQNAME(24) = 'DO_NH4_NITRIFICATION'  
      WQNAME(25) = 'DO_COD_OXIDATION    '  
      WQNAME(26) = 'DO_PHOTOSYNTH_CHL   '  
      WQNAME(27) = 'DO_RESPIRATION_CHL  '  
      WQNAME(28) = 'DO_PHOTOSYNTH_MAC   '  
      WQNAME(29) = 'DO_RESPIRATION_MAC  '  
      WQNAME(30) = 'DO_DEFICIT          '  
      WQNAME(31) = 'DO_TRANSPORT        '  
      WQNAME(32) = 'DO_ALL_COMPONENTS   '  
      WQNAME(33) = 'LAYER_THICKNESS     '  
C  
C BE SURE WQUNITS STRINGS ARE EXACTLY 10-CHARACTERS LONG:  
C-------------------'         1'  
C-------------------'1234567890'  
C  
      WQUNITS( 1) = 'UNITLESS  '  
      WQUNITS( 2) = 'UNITLESS  '  
      WQUNITS( 3) = 'UNITLESS  '  
      WQUNITS( 4) = 'UNITLESS  '  
      WQUNITS( 5) = 'UNITLESS  '  
      WQUNITS( 6) = 'UNITLESS  '  
      WQUNITS( 7) = 'UNITLESS  '  
      WQUNITS( 8) = 'UNITLESS  '  
      WQUNITS( 9) = 'UNITLESS  '  
      WQUNITS(10) = 'UNITLESS  '  
      WQUNITS(11) = 'UNITLESS  '  
      WQUNITS(12) = 'UNITLESS  '  
      WQUNITS(13) = 'UNITLESS  '  
      WQUNITS(14) = 'UNITLESS  '  
      WQUNITS(15) = 'UNITLESS  '  
      WQUNITS(16) = 'UNITLESS  '  
      WQUNITS(17) = 'UNITLESS  '  
      WQUNITS(18) = 'UNITLESS  '  
      WQUNITS(19) = 'MG/L/DAY  '  
      WQUNITS(20) = 'MG/L/DAY  '  
      WQUNITS(21) = 'MG/L/DAY  '  
      WQUNITS(22) = 'MG/L/DAY  '  
      WQUNITS(23) = 'MG/L/DAY  '  
      WQUNITS(24) = 'MG/L/DAY  '  
      WQUNITS(25) = 'MG/L/DAY  '  
      WQUNITS(26) = 'MG/L/DAY  '  
      WQUNITS(27) = 'MG/L/DAY  '  
      WQUNITS(28) = 'MG/L/DAY  '  
      WQUNITS(29) = 'MG/L/DAY  '  
      WQUNITS(30) = 'MG/L/DAY  '  
      WQUNITS(31) = 'MG/L/DAY  '  
      WQUNITS(32) = 'MG/L/DAY  '  
      WQUNITS(33) = 'METERS    '  
C  
C BE SURE WQCODE STRINGS ARE EXACTLY 3-CHARACTERS LONG:  
C------------------'123'  
C  
      WQCODE( 1) = 'NLC'  
      WQCODE( 2) = 'NLD'  
      WQCODE( 3) = 'NLG'  
      WQCODE( 4) = 'NLM'  
      WQCODE( 5) = 'PLC'  
      WQCODE( 6) = 'PLD'  
      WQCODE( 7) = 'PLG'  
      WQCODE( 8) = 'PLM'  
      WQCODE( 9) = 'LLC'  
      WQCODE(10) = 'LLD'  
      WQCODE(11) = 'LLG'  
      WQCODE(12) = 'LLM'  
      WQCODE(13) = 'TLC'  
      WQCODE(14) = 'TLD'  
      WQCODE(15) = 'TLG'  
      WQCODE(16) = 'TLM'  
      WQCODE(17) = 'VLM'  
      WQCODE(18) = 'DLM'  
      WQCODE(19) = 'DCS'  
      WQCODE(20) = 'DPS'  
      WQCODE(21) = 'DSO'  
      WQCODE(22) = 'DKA'  
      WQCODE(23) = 'DCA'  
      WQCODE(24) = 'DNH'  
      WQCODE(25) = 'DCO'  
      WQCODE(26) = 'DPC'  
      WQCODE(27) = 'DRC'  
      WQCODE(28) = 'DPM'  
      WQCODE(29) = 'DRM'  
      WQCODE(30) = 'DEF'  
      WQCODE(31) = 'DTR'  
      WQCODE(32) = 'DAL'  
      WQCODE(33) = 'DZZ'  
C  
C IF WQDOCOMP.BIN ALREADY EXISTS, OPEN FOR APPENDING HERE.  
C  
      IF(ISCOMP .EQ. 2)THEN  
        IO = 1  
    5   IO = IO+1  
        IF(IO .GT. 99)THEN  
      WRITE(0,*) ' NO AVAILABLE IO UNITS ... IO > 99'  
      STOP ' EFDC HALTED IN SUBROUTINE INITBIN3'  
      ENDIF  
        INQUIRE(UNIT=IO, OPENED=IS2OPEN)  
        IF(IS2OPEN) GOTO 5  
        INQUIRE(FILE='WQDOCOMP.BIN', EXIST=FEXIST)  
        IF(FEXIST)THEN  
          OPEN(UNIT=IO, FILE='WQDOCOMP.BIN', ACCESS='DIRECT',  
     &        FORM='UNFORMATTED', STATUS='UNKNOWN', RECL=MAXRECL3)  
      WRITE(0,*) 'OLD FILE WQDOCOMP.BIN FOUND...OPENING FOR APPEND'  
          READ(IO, REC=1) NREC3, TBEGAN, TEND, DT, IWQTSDT, NPARM,  
     &        NCELLS, KC  
          NR5 = 1 + NPARM*3 + NCELLS*4 + (NCELLS*KC+1)*NREC3 + 1  
          CLOSE(IO)  
        ELSE  
          ISCOMP=1  
        ENDIF  
      ENDIF  
C  
C IF WQDOCOMP.BIN ALREADY EXISTS, DELETE IT HERE.  
C  
      IF(ISCOMP .EQ. 1)THEN  
        TBEGAN = TBEGIN  
        IO = 1  
   10   IO = IO+1  
        IF(IO .GT. 99)THEN  
      WRITE(0,*) ' NO AVAILABLE IO UNITS ... IO > 99'  
      STOP ' EFDC HALTED IN SUBROUTINE INITBIN3'  
      ENDIF  
        INQUIRE(UNIT=IO, OPENED=IS2OPEN)  
        IF(IS2OPEN) GOTO 10  
        INQUIRE(FILE='WQDOCOMP.BIN', EXIST=FEXIST)  
        IF(FEXIST)THEN  
          OPEN(UNIT=IO, FILE='WQDOCOMP.BIN')  
          CLOSE(UNIT=IO, STATUS='DELETE')  
      WRITE(0,*) 'OLD FILE WQDOCOMP.BIN DELETED...'  
      ENDIF  
        OPEN(UNIT=IO, FILE='WQDOCOMP.BIN', ACCESS='DIRECT',  
     &      FORM='UNFORMATTED', STATUS='UNKNOWN', RECL=MAXRECL3)  
C  
C WRITE CONTROL PARAMETERS FOR POST-PROCESSOR TO HEADER  
C SECTION OF THE WQDOCOMP.BIN BINARY FILE:  
C  
        WRITE(IO) NREC3, TBEGAN, TEND, DT, IWQTSDT, NPARM, NCELLS, KC  
        DO I=1,NPARM  
          WRITE(IO) WQNAME(I)  
        ENDDO  
        DO I=1,NPARM  
          WRITE(IO) WQUNITS(I)  
        ENDDO  
        DO I=1,NPARM  
          WRITE(IO) WQCODE(I)  
        ENDDO  
C  
C WRITE CELL I,J MAPPING REFERENCE TO HEADER SECTION OF BINARY FILE:  
C  
        DO L=2,LA  
          WRITE(IO) IL(L)  
        ENDDO  
        DO L=2,LA  
          WRITE(IO) JL(L)  
        ENDDO  
C  
C **  READ IN XLON AND YLAT OR UTME AND UTMN OF CELL CENTERS OF  
C **  CURVILINEAR PORTION OF THE GRID FROM FILE LXLY.INP:  
C  
        IO1 = 0  
   20   IO1 = IO1+1  
        IF(IO1 .GT. 99)THEN  
      WRITE(0,*) ' NO AVAILABLE IO UNITS ... IO1 > 99'  
      STOP ' EFDC HALTED IN SUBROUTINE INITBIN3'  
      ENDIF  
        INQUIRE(UNIT=IO1, OPENED=IS1OPEN)  
        IF(IS1OPEN) GOTO 20  
        OPEN(IO1,FILE='LXLY.INP',STATUS='UNKNOWN')  
        DO NS=1,4  
          READ(IO1,1111)  
        ENDDO  
 1111 FORMAT(80X)  
        DO LL=1,LVC  
          READ(IO1,*) I,J,XUTME,YUTMN  
          L=LIJ(I,J)  
          XLON(L)=XUTME  
          YLAT(L)=YUTMN  
        ENDDO  
        CLOSE(IO1)  
C  
C WRITE XLON AND YLAT OF CELL CENTERS TO HEADER SECTION OF  
C BINARY OUTPUT FILE:  
C  
        DO L=2,LA  
          WRITE(IO) XLON(L)  
        ENDDO  
        DO L=2,LA  
          WRITE(IO) YLAT(L)  
        ENDDO  
        INQUIRE(UNIT=IO, NEXTREC=NR5)  
        CLOSE(IO)  
      ENDIF  
      RETURN  
      END  

